TITLE TENDMP - DTAPE/MTAPE UTILITY - R CLEMENTS/GBH/RH/RD/RCC/JEF 6 APR 71 - V032
	IFNDEF REL,<REL=0>	;0 PAPER TAPE, 1 RELOCATABLE BINARY
	IFNDEF MAGT,<MAGT=0>	;0 DTAPE, 1 MTAPE
	IFN MAGT,<
; MAGTAPE UTILITY ROUTINE - COURTSEY DATALINE SYSTEMS J HANCOCK
	>
	IFNDEF MODE,<MODE=0>	;0 IS TD10, 1 IS 551/136
	IFNDEF CORE,<CORE=4>	;NUMBER OF 8K MEMORY BLOCKS

	IFE MODE,<SUBTTL TD10 VERSION>
	IFN MODE,<SUBTTL 551/136 VERSION>

IFE REL,<
IFE MAGT,<RIM10B>
IFN MAGT,<RIM10>>
	UTC=210
	UTS=214
	DC=200
	DTC=320
	DTS=324

F=0	;MUST BE 0. USED BY JRA'S
A=2	;MISC TEMP. HOLDS 136 CONO INDEX IN UWAIT
B=1	;TEMP. HOLDS BLOCK # COMPUTATION IN SEARCH
C=3	;HOLDS BITS FOR DECTAPE CONO DURING I/O
D=4	;HOLDS POINTERS FOR AOBJN'S THROUGH CORE
E=5	;HOLDS COUNT OF WORDS IN CURRENT DT BLOCK
P=6	;PC FOR JSP'S
CKS=7	;HAD BEEN CHECKSUM IN MACDMP
FILN=10	;NUMBER OF FILE IN DIRECTORY, 1 TO 26 OCTAL
BLKNO=11	;BLOCK NUMBER SEARCHED FOR ON TAPE
WRITE=12	;MULTI-STATE FLAG FOR DEFINING I/O OPERATION
		;1=D 0=K -1=ELSE
PNTR=13	;POINTER TO BYTE TABLE IN DIRECTORY
CH=14	;HOLDS 6BIT CHARACTER OF COMMAND, OR -1
Q=15	;ANOTHER JSP AC
G=16	;RARELY USED VERY TEMP
CT=17	;COUNT OF WORDS TO DUMP

COMPTR=BEGR+377	;COMMAND POINTER, IF SUPPLIED
	LOZAD=BEGR-203	;WHEN CORE IS CLEARED, IT
			;IS FROM 40 THRU LOZAD
	LOW=20	;FIRST LOCATION CONSIDERED FOR DUMPING
	HIGH=BEGR-203	;LAST LOCATION CONSIDERED FOR DUMPING
			;ZEROED AT BEG THESE DAYS
	FOOF=BEGR-202	;NEEDED FOR ZERO CORE SEARCH, ZEROED AT BEG1
TAB=BEGR-201		;FILE DIRECTORY
LINK=BEGR-1		;0-17=LINK, 18-27=FBN, 29-35=WC
IFE REL,<IFE MAGT,<LOC 17400+<<CORE-1>*20000>>
	 IFN MAGT,<LOC 17377+<<CORE-1>*20000>
	IOWD	LAST-BEGR+1,BEGR>>
;INITIAL ENTRY IS AT BEGR, UNLESS A COMMAND POINTER IS
;SUPPLIED IN COMPTR. IN THAT CASE, ENTRY IS AT BEGR+1

BEGR:	SETZM COMPTR	;CLEAR ANY JUNK IN COMMAND POINTER
	CONO 635550	;I/O RESET, ETC.
BEG:	JSP P,CRR	;TYPE A CR-LF
	MOVEI D,SPNT-2	;PREPARE TO REMOVE AOBJN POINTERS
BEG1:	SETZB A,FOOF	;CLEAR A TO PUT IN CORE, CLEAR
			;FOOF FOR  THE NEXT ZERO CORE SEARCH
	EXCH A,2(D)	;REMOVE HEADER LIST
	AOBJN A,.	;COUNT THROUGH TO NEXT HEADER
	MOVEI D,-1(A)	;ACCOUNT FOR OVERSHOOT IN AOBJN
	JUMPN D,BEG1	;IF WE DIDNT AOBJN A 0, GO FOR NEXT HDR
	MOVE PNTR,[XWD 500,TAB-1]	;5 BIT BYTES IN DIRECTORY
	SETZB CH,F
CRCH:	SETOI WRITE,215	;USED FOR CARRET TYPEOUT
TYI:	SETZB C,HIGH	;HOPEFULLY HIGH IS TEMPORARY
	SETZB B,E	;NAME INITIALIZING
	TLOA B,400000	;NULL NAME IS "@. "
SPACE:	MOVEI E,C-1	;EXTENSION INTO C
	HRLI E,20600	;FAKE OUT END TEST OF BYTE PTR
;STOP TAPE DRIVE
IFN MODE,<CONO UTC,0>
IFE MODE,<CONO DTC,400000>
NEXT:	ILDB A,@BEGR	;GIVES A 0 UNLESS COMMAND POINTER SUPPLIED
			;RH OF NEXT IS USED AS A CONSTANT
BELL:	SETOI FILN,207	;INITIALIZATION FOR SEARCH
	SETZB BLKNO,CT	; "
	SETZM LINK
	JUMPN A,RCH	;JUMP IF COMMAND READ FROM CORE
	CONSO TTY,40	;TYPEIN FLAG?
	JRST .-1	;NO,WAIT
	DATAI TTY,A	;GET TYPED IN CHARACTER
	JSP P,TYO	;ECHO IT (WITH PARITY)
RCH:	ANDI A,177	;STRIP OFF PARITY
	CAIN A,177	;RUBOUT?
	JRST BEGR	;YES. RESTART TENDMP
	CAIE A,33	;NEW ALTMODE?
	CAIL A,175	;OR 175 OR 176 ALTMODES?
	JRST ALTTST	;YES, SOME ALTMODE.
	CAIL A,140	;LOWER CASE CHARACTER?
	TRZ A,40	;YES. CHANGE TO UPPER CASE
	SUBI A,40	;CONVERT TO SIXBIT
	JUMPL A,CARRET	;ANY CONTROL CHARACTER
	JUMPE A,SPACE	;CHAR WAS 40
NEXT1:	TLNE E,770000	;NO MORE THAN SIX CHARS
	IDPB A,E	;GOES INTO AC1 = B
	JRST NEXT	;GET ANOTHER CHARACTER


;HERE ON JUMP BLOCK DURING LOADS, OR NUMBER>7 ALT
JBLK:
;STOP TAPE DRIVE
IFN MODE,<CONO UTC,0>
IFE MODE,<CONO DTC,400000>
	HRRM D,SADR	;SAVE STARTING ADDRESS
	JUMPN CH,BEG	;IF NOT LOADGO COMMAND
SADR:	JRST BEG	;CURRENT S.A.
LOADS:			;HERE TO LOAD TAPE TO CORE
	MOVEI D,LOZAD+1	;FIRST LOC NOT TO ZERO
	SETZM 40	;A "FEATURE"
	MOVE C,[XWD 40,41]	;PREPARE TO CLEAR CORE.
	TRNN CH,3	;SKIP ON M,N   NOT ON L,T,@
	BLT C,-1(D)	;ZERO CORE
LOAD:	JSP Q,LODUMP	;START READING FILE. LODUMP PROCESSES
			;ONE HEADER AND ITS DATA
	JRST LOAD	;IF OK, GET NEXT BLOCK.(IF NONE, 
			;LODUMP RETURNS TO JBLK.)
DELE:	SKIPN E,WRITE	;SKIP IF NOT IN THE K PHASE OF A D COMMAND.
			;OR A K COMMAND
			;ALSO, SET E =0, SO SEARCH HAPPENS IN RBLK
CLS1:	AOJA WRITE,CLSTP	; 0 TO 1. GO DUMP OUT DIRECTORY.
ERR:	SKIPA P,NEXT	;SET TO RETURN TO BEGR
CRR:	SKIPA A,CRCH	;LIKE HRROI A,215 AND SKIPA
	SKIPA A,BELL	;GET A BELL CHARACTER
TYO:	SKIPN COMPTR	;DONT TYO IF NO TYI, UNLESS ERR
	DATAO TTY,A	;TYPE OUT
	CONSZ TTY,20	;WAIT FOR TTY TO FINISH
	JRST .-1	;NOT YET
	CAIE A,215	;IF CR TYPED IN,
	JUMPGE A,(P)	;OR SIGN BIT OF CHAR ON,(SEE CRR)
	MOVEI A,12	;APPEND A LINEFEED
	JRST TYO	;GO TYPE LF

ALTTST:	TLNN B,4040	;IF ALPHA CHARACTERS, DONT GET CH
	LDB CH,E	;LAST CH BEFORE ALT, -40
	JUMPN CH,ALTMD	;IF CH NOT NULL, GOT PROCESS ALTMODE
CARRET:	MOVSI FILN,-26	;FILE NAME SPECIFIED. FIRST THING TO
			;DO IS LOOK IT UP IN DIRECTORY
LUP:	SKIPN TAB+123(FILN)	;SEARCH FOR FREE FILE
	SKIPE BLKNO,TAB+151(FILN)	;CHECK BOTH WORDS
	TDZA BLKNO,BLKNO	;ENSURE CLEAR BLOCK NUMBER
	HRRM FILN,FREE	;SAVE NUMBER OF A FREE FILE
	HLLZ G,TAB+151(FILN)	;ONLY CHECK LEFT OF 2ND WD
	CAMN B,TAB+123(FILN)	;SEARCH FOR TYPED-IN FILE
	CAME C,G		;BOTH WORDS
	AOBJN FILN,LUP	;NOT THIS ONE. KEEP LOOKING
	JUMPL FILN,BEG69	;IF FILE FOUND, JUMP
	JUMPLE WRITE,ERR	;IF NOT FOUND, BETTER BE DUMP
FREE:	MOVEI FILN,.	;DUMP & NOT FOUND, MAKE ENTRY WHERE FREE
			;(ADDRESS MODIFIED ABOVE)
	SKIPE TAB+123(FILN)	;MAKE SURE HOLE AVAILABLE
	JRST ERR	;NO FREE SLOTS

BEG69:	MOVEI FILN,1(FILN)	;FILN IS FILE #+1; CLR LH
	JUMPL WRITE,LOADS	;ALL LOAD INSTRUCTIONS
IFE MAGT,<
	SKIPN WRITE	;DELETE? (K COMMAND)
	SETZB B,C	;YES, KILL FILE
	MOVEM B,TAB+122(FILN)	;CLEAR IF DELE, ENTER IF NEW DUMP
	HLLZM C,TAB+150(FILN)	;BOTH WORDS
				;FALL INTO DUMP ROUTINE
				;WHICH IS A NO-OP FOR K


;DUMP WRITES OUT CORE ONTO TAPE

;DUMP THRU DUMP2-1 SETS UP POINTERS TO NON-ZERO CORE AREAS. THESE
;AOBJN POINTERS ARE CALLED  "HEADERS", AND PRECEDE THE DATA WHEN
;THE TAPE IS WRITTEN.
;THE FIRST HEADER IS KEPT IN SPNT. SUCCESIVE HEADERS GO INTO THE FIRST
;ZERO WORD FOLLOWING THE BLOCK CORRESPONDING TO THE PREVIOUS HEADER.
;AFTER THE LAST NON-ZERO BLOCK IS (BY DEFINITION) A ZERO, WHICH
;TERMINATES THE HEADER LIST. THIS WORD MAY BE LOCATION FOOF (37176) IF
;CORE WAS FILLED UP TO THE BASE OF TENDMP.

DUMP:			;HERE ON D,K. (BLKN)=0, FILN SET UP
	MOVN A,[XWD HIGH-LOW-1,-LOW+1]	;COUNTER TO EXAMINE 
					;CORE FOR BLOCKS OF 0
	MOVEI CKS,SPNT-1	;FIRST HEADER GOES INTO SPNT
DMP1:	SKIPN 1(A)	;FIND SOME NON-ZERO CORE
	AOBJN A,.-1	;ZERO. KEEP LOOKING.
	MOVEM A,D	;SAVE ADR
	SKIPN 1(A)	;FIND SOME ZERO CORE
	SKIPE 2(A)	;DON'T MAKE NEW BLOCK FOR 1 ZERO
	AOBJN A,.-2	;NON-ZERO. KEEP LOOKING
	SUB D,A		;GET -COUNT IN BOTH HALVES OF D
	SUBI CT,-1(D)	;COUNT N WORDS DATA, 1 HDR
	ADDI D,(A)	;GET F.A.-1 IN RH OF D
	MOVEM D,1(CKS)	;SAVE HEADER
	JUMPGE D,.+2	;ON DATA GROUPS,
	MOVE CKS,A	;GET THE HEADER
			;F.A.+W.C. IS ADR OF NEXT HEADER
			;I.E., FIRST 0 AFTER NON-ZERO BLOCK
	JUMPL A,DMP1	;LOOP IF MORE CORE
	LSH CKS,2	;SHIFT CORE SIZ FOR DIR
	SKIPLE WRITE	;IF DUMPING, SET JOBREL
	HRRM CKS,TAB+150(FILN)	;PUT IN DIR
DMP2:	MOVEI D,SPNT-1	;SET UP TO FOLLOW THE HEADERS.
	MOVEI CT,1(CT)	;CLR LH, COUNT JBLK
DMP3:	MOVE D,1(D)	;GET HEADER
	JUMPGE D,THRU	;IF NULL HEADER FOUND
	MOVEI Q,DMP3	;Q:= DMP3 AS A RETURN AFTER AOBJN
	>

IFN MAGT,<
	JRST	ERR		;HOW DID WE GET HERE?  DLS***
;DUMP WRITES OUT CORE ONTO MAGNETIC TAPE
;DUMP WRITES OUT A CORE IMAGE ON MAGNETIC TAPE WITHOUT
;ZERO COMPRESSION. THE RECORDS ARE 200(OCTAL) WORDS IN LENGTH
;AND BEGIN WITH WORD ZERO. BEFORE STARTING THE TAPE IS REWOUND.
;IT ASSUMES MTA0, AT LEAST FOR NOW.
 
	MTC=	340
	MTS=	344
DUMP:	CONO	MTC,1000	;REWIND
	CONSO	MTS,300000	;WAIT FOR BOT OR REWINDING
	JRST	.-1
	CONSO	MTS,40		;TRANSPORT READY?
	JRST	.-1
	SETZ	A,
DUMP1:	HRLI	A,-200		;WORDS PER BLOCK
	CONO	MTC,64100	;START WRITE OPERATION
DUMP2:	CONSO	MTS,1		;TD10 READY FOR DATA?
	JRST	.-1
	DATAO	MTC,(A)		;SEND OUT DATA
	AOBJN	A,DUMP2		;POINT TO NEXT WORD AND LOOP
	CONO	MTS,1		;STOP THE DRIVE
	CONSO	MTS,100		;WAIT TILL STOPPED
	JRST	.-1
	CONSZ	MTS,464610	;ANY ERRORS?
	JRST 	ERR		;YES, GO RING BELL
	AOSE	[-CORE*20000/200+2]	;ALL CORE DUMPED?
	JRST 	DUMP1		;NO
	CONO	MTC,65100	;WRITE END OF FILE
	CONSO	MTS,100		;DONE?
	JRST	.-1
	CONO	MTC,65100
	CONSO	MTS,100
	JRST	.-1
	JRST	BEGR		;ALL DONE
	>


LODUMP:	JSP P,UWAIT
	JFCL D		;IN/OUTPUT HEADER
	JUMPGE D,JBLK	;IF JRST BLOCK READ. CANT HAPPEN ON WRITE
DMP5:	JSP P,UWAIT
	JFCL 1(D)	;IN/OUTPUT DATA WORD
	AOBJN D,DMP5	;COUNT DOWN THE HEADER
	JRST (Q)	;END OF HEADER. TO DMP3 OR LOAD+1
;WRITE:  1=D  0=K  -1=ELSE

THRU:	JSP P,UWAIT	;WRITE OUT JRST BLOCK
	JFCL SADR	;FROM LOC SADR
IFE MODE,<	AOJL E,UWAIT1	;FILL OUT BLOCK, TO GET CKSM OUT>
	TRZA WRITE,-1	;THEN SET WRITE TO 0, AND GO CLOBBER
			;ANY FURTHER BLOCKS WITH THIS FILN
UWAIT:	AOJL E,UWAIT1	;RETURN ADDR = (P)      DATA ADDR = @(P)
			;E IS -WD COUNT IN BLOCK OR POSITIVE
			;BYTE POINTER FIRST TIME THRU
	HLRZ BLKNO,LINK		;SET TO FOLLOW LINK
MNLUP0:	JUMPGE WRITE,MNLUP	;WRITING OR DELETING
	JUMPN BLKNO,RBLK
MNLUP:	AOSA BLKNO	;NEXT BLOCK IN THE DIRECTORY
MNLUP1:	DPB B,PNTR	;FOR DELETE, 0 FILE NAME AND NUMBER
	ILDB A,PNTR	;SEARCH FILE DIR
	CAIN A,37
	JRST DELE	;END OF TAB MARKER, DELE GOES TO
			;CLSTP ON A "D" TO DUMP DIRECTORY
	TLO A,-1(WRITE)	;0 ON D, -1 ON K OR K PHASE OF D
	CAIE FILN,(A)	;IS THIS BLOCK ASSIGNED TO CURRENT FILE?
	JUMPN A,MNLUP	;OR MAYBE FREE? JUMP IF IN USE BY
			;ANOTHER FILE.
	DPB FILN,PNTR	;SMASH AWAY WRITE BLOCK ON D OR K. BUT
			;SEE MNLUP1 ON K.
	JUMPE WRITE,MNLUP1	;K COMMAND
	SKIPN C,LINK		;HAS LINK BEEN SET UP?
	DPB BLKNO,[XWD 101200,LINK]	;NO. PUT BLOCK IN AS FIRST BLK NO
	HRLM BLKNO,LINK	;PUT BLOCK IN AS LINK
	JUMPE C,MNLUP0		;JUMP IF THIS IS THE FIRST PASS THRU DIRECTORY
	HLRZ BLKNO,C		;GET LINKED BLOCK CHOSEN BEFORE
	MOVEI C,177		;PUT IN A WORD COUNT FOR PIP
	IORM C,LINK		;AND PUT ALL THAT INTO LINK WORD
	SUBI CT,177		;DECREMENT WORDS LEFT TO GO


;RBLK SEARCHES FOR THE BLOCK IN BLKNO, ENTERS IT GOING FORWARD,
;AND THEN READS INTO CORE, DUMPS CORE, OR COMPARES CORE AS
;DETERMINED BY CONTENTS OF WRITE.

RBLK:	HRRO C,TAPENO	;CURRENT TAPE NO.
			;SET LH TO  PREPARE FOR JUMPN IN DELE
IFE MODE,<
	TRO B,-1	;ENSURE GOING FORWARD WHEN FIRST SEARCH
	CONSO DTC,300000	;IS A DIRECTION ASSERTED?
	TRO C,210000	;NO. GO FORWARD
RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
	TRO C,300000	;TURN AROUND
RBG:	CONO DTC,20200(C)	;ISSUE THE COMMAND TO TD10.
				;200=SEARCH, 300=READ, 700=WRITE.
UWAIT1:	CONSZ DTS,672700	;ANY ERRORS?
	JRST ERR	;YES. GO DING AND THEN TYI
	CONSO DTS,1	;DATA READY?
	JRST .-3	;NO. GO WAIT SOME MORE
	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
	DATAI DTC,B	;NO. SEARCHING. GET BLOCK NO.
	TRZ C,310000	;CLOBBER DIRECTION BITS IN CONO
	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
	CONSZ DTC,100000	;COMPLEMENT DECISION IF GOING REVERSE
	TRC B,-2	;BIT 35 IS FOR  TURNAROUND SPACE.
>

IFN MODE,<
	SETOB A,B	;GO FORWARD, SET DC FOR SEARCH
	CONSZ UTS,40	;IS CHECKSUM BEING WRITTEN?
	JRST .-1	;WAIT
RB1:	TRNN B,400001	;DECIDE WHETHER TO TURN AROUND
	TRCA C,10000	;CHANGE DIRECTION AND DELAY
	CONSO UTC,200000	;UNIT SELECTED?
	TRO C,2000	;INVOKE STARTUP DELAY
RBG:	CONO UTC,220200(C)	;COMMAND TO THE  551.
				;200=SEARCH, 300=READ, 700=WRITE.
	CONO DC,4011(A)	;COMMAND TO THE 136.
UWAIT1:	CONSZ UTS,6	;ANY ERRORS?
	JRST ERR	;YES. GO DING AND THEN TYI
	CONSO DC,1000	;DATA READY?
	JRST .-3	;NO. WAIT SOME MORE
	JUMPL E,INOUT(WRITE)	;IF IN MIDST OF A DT BLOCK, DISPATCH
	DATAI DC,B	;NO. SEARCHING. GET BLOCK NUMBER
	TRZ C,2000	;DONT DELAY ANY MORE
	SUBI B,(BLKNO)	;COMPARE WITH DESIRED BLOCK
	TRNE C,10000	;COMPLEMENT IF GOING REVERSE
	TRC B,-2	;BIT 35 IS FOR TURNAROUND SPACE.
>
	JUMPN B,RB1	;JUMP IF NOT GOING FORWARD INTO (BLKNO)
	MOVNI E,200	;WORDS PER BLOCK
	MOVEM P,F	;SAVE RETURN IN AC0
	TRO C,100	;READ COMMAND, MAYBE
	JUMPLE WRITE,RB2	;JUMP IF READ
	TRO C,400	;CHANGE TO WRITE COMMAND
IFN MODE,<MOVNI A,401	;SET 136 TO OUTPUT>
	JUMPG CT,.+3
	HRRZS LINK	;IF LAST BLK, KILL LINK
	DPB E,PNTR		;AND THE DIR BYTE ← 0
RB2:	CAIE BLKNO,↑D100	;IF NOT DIRECTORY BLOCK
	MOVEI P,.+2	;SETUP NEW RETURN
	JRST RBG
	AOJ E,LINK	;IN/OUTPUT LINK
	JRA P,UWAIT1	;RESTORE CALLER ADR
			;AND PROCESS DATA WORDS

IFE MODE,<
	DATAI DTC,@(P)	;READ COMMANDS. GET WORD TO CORE
INOUT:	JRST UWAIT2	;INOUT-1 TO INOUT +1 ARE DISPATCHED TO.
	DATAO DTC,@(P)	;OUTPUT TO TAPE
UWAIT2:	AOJN E,UWAIT3	;WAS THAT THE LAST WORD IN THE DT BLOCK?
	CONO DTS,1	;YES. GIVE FUNCTION STOP TO TD10
	CONSO DTS,100000	;AND WAIT FOR CHECKSUM TO BE DONE
	JRST .-1	;NOT YET. WAIT
UWAIT3:	SOJA E,0(P)	;DONE. COMPENSATE FOR THE AOJN ABOVE, AND
			;RETURN TO CALLER OF UWAIT OR RBLK
>

IFN MODE,<
	DATAI DC,@(P)	;READ COMMANDS. GET WORD TO CORE
INOUT:	JRST UWAIT2	;INOUT-1 THRU INOUT+1 ARE DISPATCHED TO.
	DATAO DC,@(P)	;OUTPUT TO TAPE
UWAIT2:	JRST 0(P)	;RETURN TO CALLER OF UWAIT OR RBLK.
>

ALTMD:	MOVEI A,"$"
	JSP P,TYO	;ALTMODE IS PRINTED AS "$"

IFE MAGT,<
	CAIE CH,"K"-40	;FOR K, WRITE := 0
	CAIN CH,"D"-40	;FOR D, WRITE :=1
	AOJLE WRITE,.-1	;COUNT (WRITE)
	>

IFN MAGT,<
	CAIN CH,"D"-40	;FOR D, WRITE :=1
	AOJLE WRITE,.-1	;COUNT (WRITE)
	JUMPG WRITE,DUMP	;D MEANS GO DUMP ON MAG TAPE
	>

	CAIN CH,"G"-40	;GO TO PROGRAM?
	JRST @SADR	;YES. JUMP OUT
	CAIN CH,"F"-40	;FILE DIR PRINT?
	JRST FDIR	;YES. PRINT FILE DIR OF THIS TAPE
	CAIN CH,"Z"-40	;ZERO DIRECTORY?
	JRST ZDIR	;DISPATCH
	CAILE CH,27	;SKIP IF OCTAL NUMBER
	JRST TYI	;NO. GO PROCESS FILE NAME
	LSH B,3	;CONVERT SIXBIT TO OCTAL
	LSHC F,3	;F+1=B
	JUMPN B,.-2	;MAY BE MORE THAN 1 DIGIT (START ADR)
	CAILE F,7	;SKIP IF ONE DIGIT
	JRA D,JBLK	;D:=SADR. DISPATCH TO JBLK WHICH SAVES SADR.
OPNTP:			;SHIFT UNIT NUMBER LEFT FOR CONO
IFE MODE,<LSH F,11>
IFN MODE,<LSH F,3>
	HRRM F,TAPENO	;SAVE IN CORE
CLSTP:	MOVEI BLKNO,↑D100	;BLK NO OF FILE DIR
	SETZI PNTR,0	;DONT CLOBBER DIRECTORY BYTE
	JSP P,RBLK	;MOVE TO BLOCK 100
	JFCL TAB+200(E)	;READ OR WRITE DIR TAB AS DETERMINED BY WRITE
	AOJL E,UWAIT1	;COUNT THE 200 WORDS
	JRST BEG	;GO ASK FOR NEXT COMMAND

ZDIR:	MOVE A,[XWD FOOF,TAB]	;FOOF IS CLEAR
	BLT A,TAB+176	;CLEAR DIRECTORY, EXCEPT LAST WORD FOR ID
	MOVSI A,(36B4+36B9)	;RESERVE BLOCKS 1 & 2
	MOVEM A,TAB	;IN DIRECTORY
	MOVSI A,(36B9)
	MOVEM A,TAB+16	;BLK 100 (DIR) IS RESERVED TOO
	HRLOI A,7	;AND BLOCKS >1100 ARE EOT
	MOVEM A,TAB+122	;END OF BYTE TAB
	AOJA WRITE,CLS1	;SET WRITE TO OUTPUT
				;AND DUMP BLK 100.
FDIR:	MOVNI FILN,26	;26 FILES (OCTAL)
FD2:	JSP P,CRR	;CR-LF
FD3:	SKIPN C,TAB+123+26(FILN)	;FIRST WORD OF NAME. IS IT BLANK?
	AOJA C,FD1	;YES. SET C=1 AND LOOP
	JSP G,SIXBP	;PRINT FIRST WORD AND A SPACE
	HLLZ C,TAB+151+26(FILN)	;SECOND WORD OF FILE NAME
	JSP G,SIXBP	;PRINT AND CLEAR C
FD1:	AOJL FILN,FD2(C)	;CAN JUMP TO FD2 OR FD3. COUNT FILES.
	JRST BEG	;ALL FILES PRINTED OR BLANK. RETURN.

SIXBP:	MOVEI B,7	;SIXBP PRINTS C(C) IN 6BIT
			;AND ADDS A TRAILING SPACE
			;AND LEAVES (C)=0

TAPENO:			;USE ADR AS TEMP FOR CURRENT UNIT
SIXBP1:	SETZI A,.-.	;CLEAR A
	LSHC A,6
	ADDI A,40	;SIXBIT TO ASCII
	JSP P,TYO	;TYPE OUT CHARACTER
	SOJG B,SIXBP1	;LOOP IF MORE CHARACTERS
	JRST 0(G)	;RETURN

SPNT:	0		;POINTER TO HEADERS IN CORE.

	LIT


IFN MAGT,<
SLOP:	MOVE	.+3
	MOVEM	COMPTR
	JRST	BEGR+1
	XWD	440700,.+1
	BYTE	(7) "0",33,177
LAST:	JRST	SLOP
	>
IFE MAGT,<
	SLOP=COMPTR-17-.	;THIS MANY WORDS BEFORE RESERVED AREA
				;FOR COMMAND STRINGS.
;!!!!!	NOTE: ABOVE PARAMETER MUST COME OUT POSITIVE IN
;	ORDER TO MEET THE DOCUMENTATION OF RESERVED COMMAND STRING AREA.
;
;	THIS MEANS ANY CODE ADDED MUST BE COMPENSATED FOR BY
;	A CORRESPONDING TIGHTENING SOMEWHERE. GOOD LUCK.
;	TENDMP IS VERY TIGHT ALREADY.
	>

	END BEGR